Octopus Format Analysis
McCade Pearson
2025-06-17
legs <- sort(c(rep(seq(1, 7), 10), rep(8, 12)))
getPoints <- function(wins) {
case_when(wins == 0 ~ 0,
wins == 1 ~ 1,
wins == 2 ~ 1,
wins == 3 ~ 2,
wins == 4 ~ 2,
wins == 5 ~ 3,
wins == 6 ~ 3,
wins == 7 ~ 4,
wins == 8 ~ 4,
wins == 9 ~ 5,
wins == 10 ~ 5,
wins == 11 ~ 6,
wins == 12 ~ 6)}
getPoints2 <- function(wins) {
case_when(wins == 0 ~ 0,
wins == 1 ~ 1,
wins == 2 ~ 2,
wins == 3 ~ 4,
wins == 4 ~ 6,
wins == 5 ~ 9,
wins == 6 ~ 12,
wins == 7 ~ 16,
wins == 8 ~ 20,
wins == 9 ~ 25,
wins == 10 ~ 30,
wins == 11 ~ 36,
wins == 12 ~ 42)}
all_schedule <- hoopR::load_nba_schedule()
all_schedule <- all_schedule %>%
mutate(date = lubridate::ymd_hm(date)-28800) %>%
filter(type_abbreviation == "STD") %>%
filter(season_type == 2) %>%
filter(status_type_id == 3)
east <- c("MIL", "BOS", "PHI", "CLE", "BKN", "NY", "MIA", "DET", "ATL", "TOR", "WSH", "IND", "CHI", "ORL", "CHA")
Teams <- all_schedule %>%
select(home_name, home_color, home_logo, home_color, home_alternate_color, home_display_name, home_abbreviation) %>%
distinct()
get_schedule <- function(TeamName) {
HomeGames <- all_schedule %>%
filter(home_name == TeamName) %>%
select(date, home_name, home_score, away_name, away_abbreviation, away_logo, away_score, away_color, away_alternate_color, game_id) %>%
mutate(Team = home_name,
TeamScore = home_score,
OpponentScore = away_score,
Opponent = away_name,
Opponent2 = away_abbreviation,
OpponentLogo = away_logo) %>%
mutate(TeamWin = ifelse(home_score > away_score, 1, 0),
Game = "Home") %>%
select(date, Team, TeamScore, OpponentScore, Opponent, Opponent2, OpponentLogo,TeamWin, Game, game_id)
AwayGames <- all_schedule %>%
filter(away_name == TeamName) %>%
select(date, away_name, away_score, home_name, home_abbreviation, home_logo, home_score, home_color, home_alternate_color, game_id) %>%
mutate(Team = away_name,
TeamScore = away_score,
OpponentScore = home_score,
Opponent = home_name,
Opponent2 = home_abbreviation,
OpponentLogo = home_logo) %>%
mutate(TeamWin = ifelse(away_score > home_score, 1, 0),
Game = "Away") %>%
select(date, Team, TeamScore, OpponentScore, Opponent, Opponent2, OpponentLogo, TeamWin, Game, game_id)
Games <- rbind(HomeGames, AwayGames)
Games <- Games %>%
arrange((date)) %>%
mutate(Leg = legs) %>%
group_by(Leg) %>%
mutate(RunWins = cumsum(TeamWin),
Points = ifelse(TeamWin == 1, getPoints(RunWins), 0),
PointsPlaying = ifelse(TeamWin == 1, getPoints(RunWins), getPoints(RunWins+1)),
GameLeg = 1:n()) %>%
ungroup() %>%
mutate(RunningPts = cumsum(Points))
return(Games)}
Schedules <- list()
for (team in Teams$home_name) {
Schedules[[team]] <- get_schedule(team)}
Standings <- data.frame()
for(team_name in Teams$home_name) {
Standings2 <- Schedules[[team_name]] %>%
ungroup() %>%
group_by(Leg) %>%
mutate(AllWins = ifelse(date >= Today, 1, TeamWin),
RunWins = cumsum(TeamWin),
Points = ifelse(TeamWin == 1, getPoints(RunWins), 0),
MaxRunWins = cumsum(AllWins),
MaxPoints = ifelse(AllWins == 1, getPoints(MaxRunWins), 0),
PointsPlayedFor = ifelse(TeamScore > 0, getPoints(RunWins+1), 0)) %>%
ungroup() %>%
group_by(Team) %>%
summarise(GP = sum(TeamScore > 0),
W = sum(TeamWin),
L = GP-W,
Pts = sum(Points),
MPts = sum(MaxPoints),
PtsPlayed = sum(PointsPlayedFor),
PtsLost = PtsPlayed-Pts,
AdjWP = Pts/PtsPlayed,
WP = W/GP,
PPG = Pts/GP,
PPW = Pts/W,
PD = (sum(TeamScore)/GP)-(sum(OpponentScore)/GP),
WL = paste0(W,"-",L),
AdjWL = paste0(Pts,"-",PtsLost),
PD = round(PD,2),
PtsPlayed = PtsPlayed/GP,
PD = ifelse(PD >= 0, paste0("+",PD), PD)) %>%
left_join(Teams, by = c('Team' = 'home_name')) %>%
select(home_logo, home_abbreviation, Pts, WL, WP, AdjWL, AdjWP, PPG, PPW, MPts, PD, Team)
Standings <- rbind(Standings, Standings2)}
EastStandings <- Standings %>%
filter(home_abbreviation %in% east) %>%
select(-home_abbreviation) %>%
arrange(-Pts, PPW, -AdjWP) %>%
mutate(Rk = 1:15) %>%
select(12, 1:11)
gt(EastStandings) %>%
gt_theme_espn() %>%
cols_align(columns = everything(), align = c('center')) %>%
cols_align(columns = c(Rk), align = c('right')) %>%
text_transform(
locations = cells_body(columns = home_logo),
fn = function(x) {
web_image(url = EastStandings$home_logo, height = as.numeric(40))}) %>%
fmt_percent(columns = c(WP, AdjWP), decimals = 2) %>%
fmt_number(columns = c(PPG, PPW)) %>%
gt_highlight_rows(rows = 1:6, fill = "#8CD47E") %>%
gt_highlight_rows(rows = 7:10, fill = "#F8D66D") %>%
gt_highlight_rows(rows = 11:15, fill = "#FF6961") %>%
tab_style(style = list(cell_fill(color = "black"), cell_text(color = "white", align = "center")), locations = cells_column_labels()) %>%
cols_label(home_logo = "",
WL = "W-L",
WP = "Pct",
AdjWL = "Adj. W-L",
AdjWP = "Adj. Pct",
MPts = "Max Pts") %>%
cols_width(Rk ~ px(25), home_logo ~ px(67), Pts ~ px(50), WL ~ px(60), WP ~ px(60), AdjWL ~ px(75), AdjWP ~ px(75), PPG ~ px(50), PPW ~ px(50), MPts ~ px(75), PD ~ px(60)) %>%
tab_header(title = "EASTERN CONFERENCE STANDINGS") %>%
tab_style(style = list(cell_fill(color = "#17408B"), cell_text(color = "white", align = "center")), locations = cells_title()) %>%
cols_hide(Team)
| EASTERN CONFERENCE STANDINGS |
| Rk |
|
Pts |
W-L |
Pct |
Adj. W-L |
Adj. Pct |
PPG |
PPW |
Max Pts |
PD |
| 1 |
 |
165 |
64-18 |
78.05% |
165-95 |
63.46% |
2.01 |
2.58 |
165 |
+9.54 |
| 2 |
 |
151 |
61-21 |
74.39% |
151-92 |
62.14% |
1.84 |
2.48 |
151 |
+9.11 |
| 3 |
 |
111 |
51-31 |
62.20% |
111-93 |
54.41% |
1.35 |
2.18 |
111 |
+4.1 |
| 4 |
 |
108 |
50-32 |
60.98% |
108-73 |
59.67% |
1.32 |
2.16 |
108 |
+2.23 |
| 5 |
 |
107 |
48-34 |
58.54% |
107-77 |
58.15% |
1.30 |
2.23 |
107 |
+2.48 |
| 6 |
 |
88 |
44-38 |
53.66% |
88-95 |
48.09% |
1.07 |
2.00 |
88 |
+1.9 |
| 7 |
 |
86 |
41-41 |
50.00% |
86-98 |
46.74% |
1.05 |
2.10 |
86 |
-0.12 |
| 8 |
 |
75 |
40-42 |
48.78% |
75-100 |
42.86% |
0.91 |
1.88 |
75 |
-1.13 |
| 9 |
 |
75 |
39-43 |
47.56% |
75-93 |
44.64% |
0.91 |
1.92 |
75 |
-1.56 |
| 10 |
 |
71 |
37-45 |
45.12% |
71-104 |
40.57% |
0.87 |
1.92 |
71 |
+0.56 |
| 11 |
 |
52 |
30-52 |
36.59% |
52-111 |
31.90% |
0.63 |
1.73 |
52 |
-4.29 |
| 12 |
 |
41 |
24-58 |
29.27% |
41-87 |
32.03% |
0.50 |
1.71 |
41 |
-6.23 |
| 13 |
 |
37 |
26-56 |
31.71% |
37-93 |
28.46% |
0.45 |
1.42 |
37 |
-7.11 |
| 14 |
 |
25 |
19-63 |
23.17% |
25-89 |
21.93% |
0.30 |
1.32 |
25 |
-9.11 |
| 15 |
 |
23 |
18-64 |
21.95% |
23-97 |
19.17% |
0.28 |
1.28 |
23 |
-12.44 |
WestStandings <- Standings %>%
filter(!home_abbreviation %in% east) %>%
select(-home_abbreviation) %>%
arrange(-Pts, PPW, -AdjWP) %>%
mutate(Rk = 1:15) %>%
select(12, 1:11)
gt(WestStandings) %>%
gt_theme_espn() %>%
cols_align(columns = everything(), align = c('center')) %>%
cols_align(columns = c(Rk), align = c('right')) %>%
text_transform(locations = cells_body(columns = home_logo),
fn = function(x) {web_image(url = WestStandings$home_logo, height = as.numeric(40))}) %>%
fmt_percent(columns = c(WP, AdjWP), decimals = 2) %>%
fmt_number(columns = c(PPG, PPW)) %>%
gt_highlight_rows(rows = 1:6, fill = "#8CD47E") %>%
gt_highlight_rows(rows = 7:10, fill = "#F8D66D") %>%
gt_highlight_rows(rows = 11:15, fill = "#FF6961") %>%
tab_style(style = list(cell_fill(color = "black"), cell_text(color = "white", align = "center")), locations = cells_column_labels()) %>%
cols_label(home_logo = "",
WL = "W-L",
WP = "Pct",
AdjWL = "Adj. W-L",
AdjWP = "Adj. Pct",
MPts = "Max Pts") %>%
cols_width(Rk ~ px(25), home_logo ~ px(67), Pts ~ px(50), WL ~ px(60), WP ~ px(60), AdjWL ~ px(75), AdjWP ~ px(75), PPG ~ px(50), PPW ~ px(50), MPts ~ px(75), PD ~ px(60)) %>%
tab_header(title = "WESTERN CONFERENCE STANDINGS") %>%
tab_style(style = list(cell_fill(color = "#c9082A"), cell_text(color = "white", align = "center")), locations = cells_title()) %>%
cols_hide(Team)
| WESTERN CONFERENCE STANDINGS |
| Rk |
|
Pts |
W-L |
Pct |
Adj. W-L |
Adj. Pct |
PPG |
PPW |
Max Pts |
PD |
| 1 |
 |
182 |
68-14 |
82.93% |
182-73 |
71.37% |
2.22 |
2.68 |
182 |
+12.87 |
| 2 |
 |
114 |
52-30 |
63.41% |
114-89 |
56.16% |
1.39 |
2.19 |
114 |
+4.51 |
| 3 |
 |
110 |
50-32 |
60.98% |
110-84 |
56.70% |
1.34 |
2.20 |
110 |
+4.66 |
| 4 |
 |
109 |
50-32 |
60.98% |
109-88 |
55.33% |
1.33 |
2.18 |
109 |
+1.22 |
| 5 |
 |
107 |
50-32 |
60.98% |
107-92 |
53.77% |
1.30 |
2.14 |
107 |
+3.89 |
| 6 |
 |
105 |
49-33 |
59.76% |
105-97 |
51.98% |
1.28 |
2.14 |
105 |
+5 |
| 7 |
 |
105 |
48-34 |
58.54% |
105-102 |
50.72% |
1.28 |
2.19 |
105 |
+3.3 |
| 8 |
 |
102 |
48-34 |
58.54% |
102-92 |
52.58% |
1.24 |
2.12 |
102 |
+4.85 |
| 9 |
 |
76 |
40-42 |
48.78% |
76-94 |
44.71% |
0.93 |
1.90 |
76 |
+0.48 |
| 10 |
 |
76 |
39-43 |
47.56% |
76-100 |
43.18% |
0.93 |
1.95 |
76 |
-1.2 |
| 11 |
 |
66 |
36-46 |
43.90% |
66-88 |
42.86% |
0.80 |
1.83 |
66 |
-2.98 |
| 12 |
 |
65 |
36-46 |
43.90% |
65-95 |
40.62% |
0.79 |
1.81 |
65 |
-3 |
| 13 |
 |
57 |
34-48 |
41.46% |
57-95 |
37.50% |
0.70 |
1.68 |
57 |
-2.76 |
| 14 |
 |
28 |
21-61 |
25.61% |
28-103 |
21.37% |
0.34 |
1.33 |
28 |
-9.43 |
| 15 |
 |
20 |
17-65 |
20.73% |
20-88 |
18.52% |
0.24 |
1.18 |
20 |
-9.34 |
TotalSchedule <- bind_rows(Schedules)
HomeSchedule <- TotalSchedule %>%
filter(Game == "Home") %>%
rename(HLeg = Leg,
HRunWins = RunWins,
HPoints = Points,
HPointsPlaying = PointsPlaying,
HGameLeg = GameLeg,
HRunningPts = RunningPts) %>%
select(game_id, HLeg, HRunWins, HPoints, HPointsPlaying, HGameLeg, HRunningPts)
TotalSchedule <- TotalSchedule %>%
filter(Game == "Away") %>%
rename(ALeg = Leg,
ARunWins = RunWins,
APoints = Points,
APointsPlaying = PointsPlaying,
AGameLeg = GameLeg,
ARunningPts = RunningPts) %>%
left_join(HomeSchedule, by = "game_id") %>%
rename(Away = Team,
AScore = TeamScore,
HScore = OpponentScore,
Home = Opponent,
AwayWin = TeamWin) %>%
select(-OpponentLogo,-Opponent2, -Game) %>%
mutate(date = substr(date, 1, 10),
date = as.Date(date)) %>%
group_by(APointsPlaying, HPointsPlaying) %>%
mutate(Total = n()) %>%
ungroup() %>%
mutate(PointsPlaying = APointsPlaying+HPointsPlaying)
ggplot(TotalSchedule) +
geom_tile(aes(x = APointsPlaying, y = HPointsPlaying), fill = "#1D3557", color = "#3E92CC") +
geom_text(aes(x = APointsPlaying, y = HPointsPlaying, label = Total), color = "white", size = 9) +
coord_fixed() +
theme_McCadeP8() +
labs(x = "Away Playing For",
y = "Home Playing For",
title = "Octopus Points Played For Each Game",
caption = "@McCadeP8 | Data: nba.com") +
theme(panel.background = element_blank())

TotalSchedule <- bind_rows(Schedules)
TotalSchedule <- TotalSchedule %>%
left_join(Teams, by = c('Team' = 'home_name')) %>%
mutate(date = substr(date, 1, 10),
date = as.Date(date),
Conf = ifelse(home_abbreviation %in% east, "Eastern Conference", "Western Conference"),
home_color = paste0("#",home_color))
BaseTable <-
expand.grid(Team = unique(all_schedule$home_name),
Date = seq(as.Date("2024-10-22"), as.Date("2025-04-13"), by = "day"),
Frame = seq(as.Date("2024-11-19"), as.Date("2025-04-13"), by = "day")) %>%
mutate(Team = as.character(Team),
DaysDiff = Frame-Date) %>%
filter(DaysDiff >= 0 & DaysDiff <= 28) %>%
select(-DaysDiff) %>%
mutate(Frame = Frame-as.Date("2024-11-18"),
Frame = as.numeric(Frame)) %>%
left_join(TotalSchedule, by = c('Team', 'Date' = 'date')) %>%
mutate(PlayedToday = ifelse(is.na(TeamScore == T), F, T)) %>%
select(Team, Date, RunningPts, PlayedToday, Frame) %>%
arrange(Team, Frame, Date)
StandingsByDay <- BaseTable %>%
select(Team, Date, RunningPts) %>%
arrange(Team, Date) %>%
group_by(Team) %>%
fill(RunningPts, .direction = "down") %>%
ungroup() %>%
mutate(RunningPts = ifelse(is.na(RunningPts) == T, 0, RunningPts)) %>%
left_join(Teams, by = c('Team' = 'home_name')) %>%
mutate(home_color = paste0("#",home_color),
home_alternate_color = paste0("#",home_alternate_color),
Conf = ifelse(home_abbreviation %in% east, "EASTERN CONFERENCE", "WESTERN CONFERENCE")) %>%
distinct()
BaseTable <- BaseTable %>%
select(-RunningPts) %>%
left_join(StandingsByDay, by = c('Team', 'Date'))
LabelData <- BaseTable %>%
group_by(Team, Frame) %>%
mutate(Rk = n():1) %>%
filter(Rk == 1) %>%
select(-Rk)
Games <- BaseTable %>%
filter(PlayedToday == T)
ggplot() +
geom_line(data = BaseTable, aes(x = Date, y = RunningPts, group = Team, color = home_color), size = 1) +
geom_point(data = Games, aes(x = Date+0.5, y = RunningPts, color = home_color), size = 4) +
geom_label(data = LabelData, aes(x = Date, y = RunningPts, label = Team, fill = home_color, color = home_alternate_color), hjust = 0) +
scale_color_identity() +
scale_fill_identity() +
scale_x_date(date_labels = "%b %e", date_breaks = "2 days") +
scale_y_continuous(position = "right", breaks = seq(0,180, by = 20), labels = function(x) paste0(x, "Pts")) +
theme_McCadeP8() +
theme(axis.text = element_text(size = 12), strip.text = element_text(size = 14, face = "bold")) +
labs(title = "NBA Standings: Octopus Point Format",
x = "",
y = "") +
facet_wrap(~Conf, ncol = 1) +
transition_states(Frame) +
ease_aes('linear') +
view_follow(fixed_x = FALSE)
